home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / misc.swg / 0066_TRAP8087 Errors.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-26  |  1.9 KB  |  86 lines
  1. {
  2. Here is how to trap errors on the 80X87.  I am not sure yet how it works with
  3. the FP emulation library, but if you have a math coprocessor, you can trap
  4. any FP exceptions:
  5. }
  6.  
  7. {$N+,E+}
  8. program FloatTest;
  9. { compliments of Steve Schafer, Compuserve address 76711, 522 }
  10. const
  11.   feInvalidOp  = $01;
  12.   feDenormalOp = $02;
  13.   feZeroDivide = $04;
  14.   feOverFlow   = $08;
  15.   feUnderFlow  = $10;
  16.   fePrecision  = $20;
  17.  
  18. procedure SetFpuExceptionMask (MaskBits: Byte); assembler;
  19. { Masks floating point exceptions so that they won't cause a crash }
  20. var
  21.   Temp: word;
  22. asm
  23.   fstcw Temp
  24.   fwait
  25.   mov ax, Temp
  26.   and al, $F0
  27.   or al, MaskBits
  28.   mov Temp, ax
  29.   fldcw Temp
  30.   fwait
  31. end;
  32.  
  33. function GetFpuStatus: Byte; assembler;
  34. { determines the status of a previous FP operation }
  35. var
  36.   Temp: word;
  37. asm
  38.   fstsw Temp
  39.   fwait
  40.   mov ax, Temp
  41. end;
  42.  
  43. procedure WriteStatus(Status: Byte);
  44. { This procedure is not necessary, it simply illustrates how to determine
  45.   what happenend }
  46. begin
  47.   if (Status and fePrecision) <> 0 then Write('P')
  48.   else Write('-');
  49.   if (Status and feUnderflow) <> 0 then Write('U')
  50.   else Write('-');
  51.   if (Status and feOverflow) <> 0 then Write('O')
  52.   else Write('-');
  53.   if (Status and feZeroDivide) <> 0 then Write('Z')
  54.   else Write('-');
  55.   if (Status and feDenormalOp) <> 0 then Write('D')
  56.   else Write('-');
  57.   if (Status and feInvalidOp) <> 0 then Write('I')
  58.   else Write('-');
  59. end;
  60.  
  61. var
  62.   X,Y: Single;
  63.  
  64. begin
  65.   SetFPUExceptionMask (feInvalidOp + feDenormalOp + feZeroDivide
  66.                      + feOverflow  + feUnderflow  + fePrecision);
  67.  
  68.   X:= -1.0;
  69.   Y:= Sqrt(X);  { Invalid Operation }
  70.   WriteStatus(GetFPUStatus);  
  71.   Writeln('  ', Y:12, '  ', X:12);
  72.  
  73.   X:= 0.0;
  74.   Y:= 1.0;
  75.   Y:= Y/X;  { divide by Zero }
  76.   WriteStatus(GetFPUStatus);
  77.   Writeln('  ', Y:12, '  ', X:12);
  78.  
  79.   X:= 1.0E-34;
  80.   Y:= 1.0E-34;
  81.   Y:= Y*X;  { Underflow }
  82.   WriteStatus(GetFPUStatus);
  83.   Writeln('  ', Y:12, '  ', X:12);
  84.  
  85. end.
  86.